home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / qbsnip.zip / QUIKTERM.BAS < prev    next >
Encoding:
BASIC Source File  |  1997-06-20  |  7.6 KB  |  204 lines
  1. '_|_|_|   QUIKTERM.BAS
  2. '_|_|_|   This program will operate in ANSI emulation with ANSI
  3. '_|_|_|   auto-detect. Must be compiled for high speeds.
  4. '_|_|_|   No warrantee or guarantee is given or implied.
  5. '_|_|_|   Released to   PUBLIC DOMAIN   by Kurt Kuzba.  (6/5/96)
  6.  
  7. DECLARE SUB QuikCFG (d() AS STRING)
  8. DECLARE SUB ansi (A$)
  9. ON ERROR GOTO BooBoo
  10. DIM FKEYS(13) AS STRING: port% = 0
  11. FError$ = "ok": OPEN "quikterm.cfg" FOR INPUT AS #2
  12. IF FError$ = "ok" THEN
  13.    FOR t% = 0 TO 13
  14.       IF EOF(2) THEN EXIT FOR
  15.       LINE INPUT #2, FKEYS(t%)
  16.    NEXT: port% = VAL(FKEYS(0))
  17. END IF: CLOSE 2
  18. Ex$ = CHR$(27) + "[": CrLf$ = CHR$(13) + CHR$(10)
  19. CLS : altx$ = Ex$ + "0;1;32mALT/X to exit terminal" + CrLf$
  20. IF port% = 0 THEN
  21.    LOCATE 1, 1, 1: PRINT "Choose a port (1/2)"
  22.    DO: port% = INSTR(" 12", INKEY$): LOOP WHILE port% < 2
  23.    port% = port% - 1: FError$ = "ok"
  24.    OPEN "quikterm.cfg" FOR OUTPUT AS #2
  25.    IF FError$ = "ok" THEN PRINT #2, MID$(STR$(port%), 2)
  26. END IF: CLOSE 2
  27. FOR t% = 1 TO 34: ansi MID$(altx$, t%, 1): NEXT
  28. port$ = "COM" + MID$(STR$(port%), 2) + ":19200,N,8,1"
  29. FError$ = "ok": OPEN port$ FOR RANDOM AS #1 LEN = 8192
  30. IF FError$ <> "ok" THEN PRINT "MODEM ERROR": END
  31. DO
  32.    Modemin$ = "": IF NOT EOF(1) THEN Modemin$ = INPUT$(1, #1)
  33.    ansi Modemin$
  34.    IF ANSIDetect$ <> "" THEN PRINT #1, ANSIDetect$: ANSIDetect$ = ""
  35.    kb$ = INKEY$
  36.    IF kb$ <> "" THEN
  37.       k% = ASC(kb$)
  38.       IF k% = 0 THEN
  39.          k% = ASC(MID$(kb$, 2))
  40.          SELECT CASE k%
  41.             CASE 45: CLOSE #1: END
  42.             CASE 59 TO 68: k% = k% - 58
  43.                kb$ = FKEYS(k%)
  44.                DO: e% = INSTR(UCASE$(kb$), "^M")
  45.                   IF e% > 0 THEN MID$(kb$, e%) = MID$(kb$, e% + 1)
  46.                   IF e% > 0 THEN kb$ = LEFT$(kb$, LEN(kb$) - 1)
  47.                   IF e% > 0 THEN MID$(kb$, e%, 1) = CHR$(13)
  48.                LOOP WHILE e% > 0
  49.                IF FKEYS(k%) = "" THEN k% = 0
  50.             CASE 133, 134: k% = k% = 122
  51.                kb$ = FKEYS(k%)
  52.                IF FKEYS(k%) = "" THEN k% = 0
  53.             CASE 37: QuikCFG FKEYS(): k% = 0
  54.             CASE ELSE: k% = 0
  55.          END SELECT
  56.       END IF: IF k% > 0 THEN PRINT #1, kb$;
  57.    END IF
  58. LOOP: CLOSE #1: END
  59. BooBoo:
  60.    FError$ = STR$(ERR): RESUME NEXT
  61. DEFINT A-Z
  62.  
  63. SUB ansi (A$)
  64. DEFINT A-Z: DEF SEG = &HB800
  65. STATIC W, e, L, C, O, M, F, B, V, e$: SHARED ANSIDetect$
  66. IF W < 99 THEN W = 100: C = 0: F = 7: B = 0: A = 0: M = F + 16 * B
  67. IF A$ = "" THEN LOCATE C \ 80 + 1, C MOD 80 + 1, 1: EXIT SUB
  68. IF e <> 27 THEN
  69.    IF ASC(A$) <> 27 THEN GOSUB CHRout:  ELSE e = 27: e$ = A$
  70.    EXIT SUB
  71. END IF
  72. IF O <> 27 AND ASC(A$) = 34 THEN O = e: EXIT SUB
  73. IF O = 27 THEN
  74.    IF ASC(A$) = 34 THEN O = 0
  75.    EXIT SUB
  76. END IF: e$ = e$ + A$
  77. IF LEN(e$) = 2 AND A$ <> "[" THEN e = 0: e$ = "": EXIT SUB
  78. S = INSTR("HfABCDsuJKmhlpn", A$)
  79. SELECT CASE S
  80.   CASE 0: EXIT SUB
  81.   CASE 1: GOSUB CursorA
  82.   CASE 2: GOSUB CursorA
  83.   CASE 3: L = -1: GOSUB CursorL
  84.   CASE 4: L = 1: GOSUB CursorL
  85.   CASE 5: L = 1: GOSUB CursorC
  86.   CASE 6: L = -1: GOSUB CursorC
  87.   CASE 7: V = C
  88.   CASE 8: C = V
  89.   CASE 9: COLOR F, B: CLS : C = 0
  90.   CASE 10: FOR L = C TO C + 79 - (C MOD 80)
  91.            POKE L * 2, 32: POKE L * 2 + 1, M: NEXT
  92.   CASE 11: GOSUB Colorz
  93.   CASE 15: A$ = CHR$(27) + "[" + MID$(STR$(C \ 80 + 1), 2) + ";"
  94.            ANSIDetect$ = A$ + MID$(STR$((C MOD 80) + 1), 2) + "R"
  95. END SELECT: e = 0: e$ = "": EXIT SUB
  96. CursorA: L = VAL(MID$(e$, INSTR(e$, "[") + 1))
  97.    C = VAL(MID$(e$, INSTR(e$, ";") + 1))
  98.    IF C > 0 THEN C = (C - 1): IF C > 79 THEN C = 79
  99.    IF L > 0 THEN L = (L - 1): IF L > 24 THEN L = 24
  100.    C = L * 80 + C: RETURN
  101. CursorL: p = VAL(MID$(e$, INSTR(e$, "[") + 1))
  102.    p = p - (p < 1): L = INT(C \ 80) + p * L
  103.    IF L < 0 THEN L = 0:  ELSE IF L > 24 THEN L = 24
  104.    C = (C MOD 80) + L * 80: RETURN
  105. CursorC: p = VAL(MID$(e$, INSTR(e$, "[") + 1))
  106.    p = p - (p < 1): L = (C MOD 80) + p * L: C = INT(C \ 80) * 80
  107.    IF L < 1 THEN L = 0:  ELSE IF L > 79 THEN L = 79
  108.    C = C + L: RETURN
  109. Colorz: e$ = MID$(e$, INSTR(e$, "[") + 1)
  110.    DO: e = VAL(e$)
  111.       SELECT CASE e
  112.          CASE 0: F = 7: B = 0
  113.          CASE 1: F = F OR 8
  114.          CASE 5: B = B OR 8
  115.          CASE 8: F = B
  116.          CASE 30 TO 37: p = e - 29
  117.             e = ASC(MID$("@DBFAECG", p)) AND 7: F = (F AND 248) + e
  118.          CASE 40 TO 47: p = e - 39
  119.             e = ASC(MID$("@DBFAECG", p)) AND 7: B = (B AND 248) + e
  120.       END SELECT: p = INSTR(e$, ";"): e$ = MID$(e$, p + 1)
  121.    LOOP WHILE p > 0: M = F + 16 * B: RETURN
  122. CHRout: p = ASC(A$)
  123.    IF p = 7 THEN FOR t% = 800 TO 1111 STEP 20: SOUND t%, .1: NEXT: RETURN
  124.    IF p = 8 THEN
  125.       IF (C MOD 80) > 0 THEN
  126.          FOR t% = C * 2 TO (C \ 80) * 160 + 159
  127.             POKE t% - 2, PEEK(t%)
  128.          NEXT: C = C - 1
  129.       END IF: RETURN
  130.    END IF
  131.    IF p = 13 THEN C = C - (C MOD 80): RETURN
  132.    IF p = 10 THEN C = C + 80
  133.    IF p <> 10 THEN POKE C * 2, p: POKE C * 2 + 1, M: C = C + 1
  134.    IF C >= 2000 THEN
  135.       C = C - 80: LOCATE 30, 80: PRINT
  136.       DIM PK%(2): PK%(0) = 32: PK%(1) = M
  137.       FOR L = 3680 TO 3839
  138.          POKE L, PEEK(L + 160): POKE L + 160, PK%(L AND 1)
  139.       NEXT
  140.    END IF: RETURN
  141. END SUB
  142.  
  143. SUB QuikCFG (d() AS STRING)
  144.    SHARED port%
  145.    DIM buf(4000) AS STRING * 1: DEF SEG = &HB800: F$ = SPACE$(80)
  146.    FOR t% = 0 TO 3999: buf(t%) = CHR$(PEEK(t%)): NEXT
  147.    csr% = LEN(d(0)) + 1: macro% = 0: COLOR 10, 0: CLS : COLOR 14, 4
  148.    PRINT " COM "; : COLOR 10, 0: PRINT LEFT$(d(0) + F$, 75);
  149.    FOR t% = 1 TO 12
  150.       COLOR 14, 4: LOCATE t% + 1, 1: PRINT " F"; RIGHT$(STR$(t%), 2); " ";
  151.       COLOR 10, 0: PRINT LEFT$(d(t%) + F$, 75); : NEXT
  152.    PRINT : PRINT : PRINT "RETURN exits: ALT/S saves"
  153.    DO: LOCATE macro% + 1, 6: COLOR 15, 1: PRINT LEFT$(d(macro%) + F$, 75);
  154.       LOCATE , csr% + 5: DO: k$ = INKEY$: LOOP WHILE k$ = ""
  155.       k% = ASC(k$): IF k% = 0 THEN k% = -ASC(MID$(k$, 2))
  156.       SELECT CASE k%
  157.          CASE 8
  158.             IF csr% > 1 THEN
  159.                csr% = csr% - 1
  160.                MID$(d(macro%), csr%) = MID$(d(macro%), csr% + 1)
  161.                d(macro%) = LEFT$(d(macro%), LEN(d(macro%)) - 1)
  162.             ELSE SOUND 999, .7
  163.             END IF
  164.          CASE 13: FOR t% = 0 TO 3999: POKE t%, ASC(buf(t%)): NEXT: EXIT SUB
  165.          CASE 32 TO 255
  166.             L$ = LEFT$(d(macro%), csr% - 1): r$ = MID$(d(macro%), csr%)
  167.             d(macro%) = LEFT$(L$ + k$ + r$, 70)
  168.             IF csr% < 75 THEN csr% = csr% + 1:  ELSE SOUND 999, .7
  169.          CASE -31
  170.             FError$ = "ok": OPEN "quikterm.cfg" FOR OUTPUT AS #2
  171.             IF FError$ = "ok" THEN
  172.                FOR t% = 0 TO 13: PRINT #2, d(t%): NEXT: port% = VAL(d(0))
  173.             END IF: CLOSE 2
  174.          CASE -71: csr% = 1
  175.          CASE -72
  176.             IF macro% > 0 THEN
  177.                LOCATE macro% + 1, 6: COLOR 10, 0
  178.                PRINT LEFT$(d(macro%) + F$, 75);
  179.                macro% = macro% - 1: csr% = LEN(d(macro%)) + 1
  180.             ELSE SOUND 999, .7
  181.             END IF
  182.          CASE -75
  183.             IF csr% > 1 THEN csr% = csr% - 1:  ELSE SOUND 999, .7
  184.          CASE -77
  185.             IF csr% < 70 THEN csr% = csr% + 1:  ELSE SOUND 999, .7
  186.          CASE -79: csr% = LEN(d(macro%)) + 1
  187.          CASE -80
  188.             IF macro% < 12 THEN
  189.                LOCATE macro% + 1, 6: COLOR 10, 0
  190.                PRINT LEFT$(d(macro%) + F$, 75);
  191.                macro% = macro% + 1: csr% = LEN(d(macro%)) + 1
  192.             ELSE SOUND 999, .7
  193.             END IF
  194.          CASE -83
  195.             IF LEN(d(macro%)) >= csr% THEN
  196.                MID$(d(macro%), csr%) = MID$(d(macro%), csr% + 1)
  197.                d(macro%) = LEFT$(d(macro%), LEN(d(macro%)) - 1)
  198.             ELSE SOUND 999, .7
  199.             END IF
  200.       END SELECT
  201.    LOOP
  202. END SUB
  203.  
  204.